home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue52 / RegValet / HexViewer / HexViewer.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-11-01  |  7.3 KB  |  302 lines
  1. unit HexViewer;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls, RegValet, Menus;
  8.  
  9. type
  10.   TfrmHexViewer = class(TForm)
  11.     reData: TRichEdit;
  12.     lblFileName: TLabel;
  13.     rvJeeves: TRegValet;
  14.     mmMain: TMainMenu;
  15.     miFile: TMenuItem;
  16.     miExit: TMenuItem;
  17.     miOpen: TMenuItem;
  18.     miOptions: TMenuItem;
  19.     miSmallFont: TMenuItem;
  20.     miNormalFont: TMenuItem;
  21.     miLargeFont: TMenuItem;
  22.     miSep2: TMenuItem;
  23.     mi16CharsPerLine: TMenuItem;
  24.     mi32CharsPerLine: TMenuItem;
  25.     miSep1: TMenuItem;
  26.     miFile0: TMenuItem;
  27.     miFile1: TMenuItem;
  28.     miFile2: TMenuItem;
  29.     miFile3: TMenuItem;
  30.     miFile4: TMenuItem;
  31.     miFile5: TMenuItem;
  32.     miFile6: TMenuItem;
  33.     miFile7: TMenuItem;
  34.     miFile8: TMenuItem;
  35.     miFile9: TMenuItem;
  36.     odOpen: TOpenDialog;
  37.     procedure FormShow(Sender: TObject);
  38.     procedure ExitClick(Sender: TObject);
  39.     procedure FileOpenClick(Sender: TObject);
  40.     procedure FontSizeClick(Sender: TObject);
  41.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  42.     procedure HistFileListClick(Sender: TObject);
  43.     procedure CharsPerLineClick(Sender: TObject);
  44.     procedure SetFileMenuItems(Sender: TObject);
  45.   private
  46.     CurrFile: String;
  47.     FontSize: Integer;
  48.     CharsPerLine: Integer;
  49.   private
  50.     procedure InitializeFromRegistry;
  51.     procedure LoadFile(const FileName: String);
  52.     procedure SetMenuItemChecks;
  53.   public
  54.   end;
  55.  
  56. var
  57.   frmHexViewer: TfrmHexViewer;
  58.  
  59. implementation
  60.  
  61. {$R *.DFM}
  62.  
  63. const
  64.   SMALL_FONT_SIZE = 8;
  65.   NORMAL_FONT_SIZE = 10;
  66.   LARGE_FONT_SIZE = 12;
  67.  
  68.   FILE_HISTORY = 'FileHistory';
  69.   FONT_SIZE = 'FontSize';
  70.   CHARS_PER_LINE = 'CharsPerLine';
  71.  
  72. { Format routine }
  73.  
  74. procedure FormatFile(MS: TMemoryStream; CharsPerLine: Integer;
  75.     Lines: TStrings);
  76. const
  77.   HexChar: array[0..15] of Char =
  78.     ('0', '1', '2', '3', '4', '5', '6', '7',
  79.         '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
  80. var
  81.   I:          Integer;
  82.   J:          Integer;
  83.   Offset:     Integer;
  84.   PC:         PChar;
  85.   BH:         Byte;
  86.   BL:         Byte;
  87.   OutS:       String[116];
  88.   OffsetS:    String[8];
  89.   HexS:       String[64];
  90.   CharS:      String[32];
  91.  
  92.   procedure FormatLine(Offset: Integer);
  93.   var
  94.     I:      Integer;
  95.   begin
  96.     OffSetS := Format('%8.8x', [Offset]);
  97.     if Length(HexS) < (CharsPerLine * 2) then
  98.       HexS := HexS + StringOfChar(' ',
  99.           ((CharsPerLine * 2) - Length(HexS)));
  100.     OutS := OffsetS + '  ' + Copy(HexS, 1, 8) + ' ' +
  101.         Copy(HexS, 9, 8) + ' ' + Copy(HexS, 17, 8) + ' ' +
  102.         Copy(HexS, 25, 8) + '  ';
  103.     if CharsPerLine = 32 then
  104.       OutS := OutS + Copy(HexS, 33, 8) + ' ' +
  105.         Copy(HexS, 41, 8) + ' ' + Copy(HexS, 49, 8) + ' ' +
  106.         Copy(HexS, 57, 8) + '  ';
  107.     for I := 1 to CharsPerLine do
  108.     begin
  109.       if not (Ord(CharS[I]) in [32..127]) then
  110.         CharS[I] := '.';
  111.     end;
  112.     OutS := OutS + CharS;
  113.   end;
  114.  
  115. begin
  116.   Lines.Clear;
  117.   Lines.BeginUpdate;
  118.   I := 0;
  119.   J := 0;
  120.   Offset := 0;
  121.   PC := MS.Memory;
  122.   HexS := '';
  123.   CharS := '';
  124.   while (I < MS.Size) do
  125.   begin
  126.     while True do
  127.     begin
  128.       Inc(J);
  129.       if (J = (CharsPerLine + 1)) or (I = MS.Size) then
  130.       begin
  131.         FormatLine(Offset);
  132.         try
  133.           Lines.Add(OutS);
  134.         except
  135.           ShowMessage('File too big for display control - ' +
  136.               'full file contents not available for display');
  137.           Lines.EndUpdate;
  138.           Exit;
  139.         end;
  140.         Inc(Offset, CharsPerLine);
  141.         J := 0;
  142.         HexS := '';
  143.         CharS := '';
  144.         Break;
  145.       end;
  146.       if I < MS.Size then
  147.       begin
  148.         BH := Ord(PC^);
  149.         BL := BH;
  150.         BH := BH shr 4;
  151.         BL := BL mod 16;
  152.         HexS := HexS + HexChar[BH] + HexChar[BL];
  153.         CharS := CharS + PC^;
  154.         Inc(I);
  155.         Inc(PC);
  156.       end;
  157.     end;
  158.   end;
  159.   Lines.EndUpdate;
  160. end;
  161.  
  162. { TfrmHexViewer }
  163.  
  164. procedure TfrmHexViewer.CharsPerLineClick(Sender: TObject);
  165. begin
  166.   if (Sender = mi16CharsPerLine) and (CharsPerLine = 32) then
  167.   begin
  168.     CharsPerLine := 16;
  169.     LoadFile(CurrFile);
  170.   end
  171.   else if (Sender = mi32CharsPerLine) and (CharsPerLine = 16) then
  172.   begin
  173.     CharsPerLine := 32;
  174.     LoadFile(CurrFile);
  175.   end;
  176.   SetMenuItemChecks;
  177.   rvJeeves[CHARS_PER_LINE] := IntToStr(CharsPerLine);
  178. end;
  179.  
  180. procedure TfrmHexViewer.ExitClick(Sender: TObject);
  181. begin
  182.   Close;
  183. end;
  184.  
  185. procedure TfrmHexViewer.FileOpenClick(Sender: TObject);
  186. begin
  187.   if odOpen.Execute then
  188.     LoadFile(odOpen.FileName);
  189. end;
  190.  
  191. procedure TfrmHexViewer.FontSizeClick(Sender: TObject);
  192. begin
  193.   if Sender = miSmallFont then
  194.     FontSize := SMALL_FONT_SIZE
  195.   else if Sender = miNormalFont then
  196.     FontSize := NORMAL_FONT_SIZE
  197.   else if Sender = miLargeFont then
  198.     FontSize := LARGE_FONT_SIZE;
  199.   rvJeeves[FONT_SIZE] := IntToStr(FontSize);
  200.   SetMenuItemChecks;
  201.   reData.Font.Size := FontSize;
  202. end;
  203.  
  204. procedure TfrmHexViewer.FormClose(Sender: TObject;
  205.   var Action: TCloseAction);
  206. begin
  207.   rvJeeves.SaveFormBounds;
  208. end;
  209.  
  210. procedure TfrmHexViewer.FormShow(Sender: TObject);
  211. begin
  212.   InitializeFromRegistry;
  213.   SetMenuItemChecks;
  214.   reData.Font.Size := FontSize;
  215. end;
  216.  
  217. procedure TfrmHexViewer.HistFileListClick(Sender: TObject);
  218. begin
  219.   LoadFile((Sender as TMenuItem).Caption);
  220. end;
  221.  
  222. procedure TfrmHexViewer.InitializeFromRegistry;
  223. var
  224.   Size: String;
  225. begin
  226.   rvJeeves.RestoreFormBounds;
  227.   CharsPerLine := 16;
  228.   if rvJeeves[CHARS_PER_LINE] = '32' then
  229.     CharsPerLine := 32;
  230.   Size := rvJeeves[FONT_SIZE];
  231.   if Size = '' then
  232.     Size := IntToStr(NORMAL_FONT_SIZE);
  233.   FontSize := StrToInt(Size);
  234. end;
  235.  
  236. procedure TfrmHexViewer.LoadFile(const FileName: String);
  237. var
  238.   MS: TMemoryStream;
  239. begin
  240.   if FileName <> '' then
  241.   begin
  242.     MS := TMemoryStream.Create;
  243.     try
  244.       try
  245.         MS.LoadFromFile(FileName);
  246.       except
  247.         rvJeeves.DeleteIndexedValue(FILE_HISTORY, FileName);
  248.         raise;
  249.       end;
  250.       FormatFile(MS, CharsPerLine, reData.Lines);
  251.       CurrFile := FileName;
  252.       lblFileName.Caption := CurrFile;
  253.       rvJeeves.MoveIndexedValueToFront(FILE_HISTORY, CurrFile);
  254.     finally
  255.       MS.Free;
  256.     end;
  257.   end;
  258. end;
  259.  
  260. procedure TfrmHexViewer.SetFileMenuItems(Sender: TObject);
  261. var
  262.   Cnt: Integer;
  263.  
  264.   procedure SetMenuItem(Index: Integer; Item: TMenuItem);
  265.   begin
  266.     Item.Visible := (Index < Cnt);
  267.     if Index < Cnt then
  268.     begin
  269.       Item.Caption := rvJeeves.IndexedValues[FILE_HISTORY, Index];
  270.       if Item.Caption = CurrFile then
  271.         Item.Visible := False;
  272.     end;
  273.   end;
  274.  
  275. begin
  276.   Cnt := rvJeeves.Count[FILE_HISTORY];
  277.   SetMenuItem(0, miFile0);
  278.   SetMenuItem(1, miFile1);
  279.   SetMenuItem(2, miFile2);
  280.   SetMenuItem(3, miFile3);
  281.   SetMenuItem(4, miFile4);
  282.   SetMenuItem(5, miFile5);
  283.   SetMenuItem(6, miFile6);
  284.   SetMenuItem(7, miFile7);
  285.   SetMenuItem(8, miFile8);
  286.   SetMenuItem(9, miFile9);
  287.   miSep1.Visible := (miFile0.Visible or miFile1.Visible);
  288. end;
  289.  
  290. procedure TfrmHexViewer.SetMenuItemChecks;
  291. begin
  292.   miSmallFont.Checked := (FontSize = SMALL_FONT_SIZE);
  293.   miNormalFont.Checked := (FontSize = NORMAL_FONT_SIZE);
  294.   miLargeFont.Checked := (FontSize = LARGE_FONT_SIZE);
  295.   mi16CharsPerLine.Checked := (CharsPerLine = 16);
  296.   mi32CharsPerLine.Checked := (CharsPerLine = 32);
  297. end;
  298.  
  299. end.
  300.  
  301.  
  302.